home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / units / strings.pp < prev    next >
Text File  |  1998-09-21  |  20KB  |  644 lines
  1. {
  2.     $Id: strings.pp,v 1.2 1998/07/01 14:29:42 carl Exp $
  3.     This file is part of the Free Pascal run time library.
  4.     Copyright (c) 1997 by Carl-Eric Codere,
  5.     member of the Free Pascal development team.
  6.  
  7.     See the file COPYING.FPC, included in this distribution,
  8.     for details about the copyright.
  9.  
  10.     This program is distributed in the hope that it will be useful,
  11.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13.  
  14.  **********************************************************************}
  15. Unit Strings;
  16.  
  17.  
  18.   {*********************************************************************}
  19.   { Strings unit, 100% portable.                                        }
  20.   {- COMPILING INFORMATION ---------------------------------------------}
  21.   {   The only difference between this  unit and the one supplied with  }
  22.   {   Turbo Pascal 7.01, are that StrLen returns a longint, and the     }
  23.   {   routines requiring a length now use longints instead of words.    }
  24.   {   This should not influence the behaviour of your programs under    }
  25.   {   Turbo Pascal. (it will even create better error checking for your }
  26.   {   programs).                                                        }
  27.   {*********************************************************************}
  28.  
  29.  Interface
  30.  {*********************************************************************}
  31.  { Returns the number of Characters in Str,not counting the Null       }
  32.  { chracter.                                                           }
  33.  {*********************************************************************}
  34.  
  35. function StrLen(Str: PChar): longint;
  36.  
  37.  
  38. function StrEnd(Str: PChar): PChar;
  39.  
  40.   {*********************************************************************}
  41.   {  Description: Move count characters from source to dest.            }
  42.   {   Do not forget to use StrLen(source)+1 as l parameter to also move }
  43.   {   the null character.                                               }
  44.   {  Return value: Dest                                                 }
  45.   {   Remarks: Source and Dest may overlap.                             }
  46.   {*********************************************************************}
  47.  
  48. function StrMove(Dest,Source : Pchar;l : Longint) : pchar;
  49.  
  50.  
  51. function StrCopy(Dest, Source: PChar): PChar;
  52.  
  53.  {*********************************************************************}
  54.  {  Input: Source -> Source of the null-terminated string to copy.     }
  55.  {         Dest   -> Destination of null terminated string to copy.    }
  56.  {    Return Value: Pointer to the end of the copied string of Dest.   }
  57.  {  Output: Dest ->   Pointer to the copied string.                    }
  58.  {*********************************************************************}
  59. function StrECopy(Dest, Source: PChar): PChar;
  60.  
  61.   {*********************************************************************}
  62.   {  Copies at most MaxLen characters from Source to Dest.              }
  63.   {                                                                     }
  64.   {   Remarks: According to the Turbo Pascal programmer's Reference     }
  65.   {    this routine performs length checking. From the code of the      }
  66.   {    original strings unit, this does not seem true...                }
  67.   {   Furthermore, copying a null string gives two null characters in   }
  68.   {   the destination according to the Turbo Pascal routine.            }
  69.   {*********************************************************************}
  70.  
  71. function StrLCopy(Dest, Source: PChar; MaxLen: Longint): PChar;
  72.  
  73.  {*********************************************************************}
  74.  {  Input: Source -> Source of the pascal style string to copy.        }
  75.  {         Dest   -> Destination of null terminated string to copy.    }
  76.  {    Return Value: Dest. (with noew copied string)                    }
  77.  {*********************************************************************}
  78.  
  79. function StrPCopy(Dest: PChar; Source: String): PChar;
  80.  
  81.  {*********************************************************************}
  82.  {  Description: Appends a copy of Source to then end of Dest and      }
  83.  {               return Dest.                                          }
  84.  {*********************************************************************}
  85.  
  86. function StrCat(Dest, Source: PChar): PChar;
  87.  
  88.  {*********************************************************************}
  89.  { Description: Appends at most MaxLen - StrLen(Dest) characters from  }
  90.  { Source to the end of Dest, and returns Dest.                        }
  91.  {*********************************************************************}
  92.  
  93.       function strlcat(dest,source : pchar;l : Longint) : pchar;
  94.  
  95.   {*********************************************************************}
  96.   {  Compares two strings. Does the ASCII value substraction of the     }
  97.   {  first non matching characters                                      }
  98.   {   Returns 0 if both strings are equal                               }
  99.   {   Returns < 0 if Str1 < Str2                                        }
  100.   {   Returns > 0 if Str1 > Str2                                        }
  101.   {*********************************************************************}
  102.  
  103. function StrComp(Str1, Str2: PChar): Integer;
  104.  
  105.   {*********************************************************************}
  106.   {  Compares two strings without case sensitivity. See StrComp for more}
  107.   {  information.                                                       }
  108.   {   Returns 0 if both strings are equal                               }
  109.   {   Returns < 0 if Str1 < Str2                                        }
  110.   {   Returns > 0 if Str1 > Str2                                        }
  111.   {*********************************************************************}
  112.  
  113. function StrIComp(Str1, Str2: PChar): Integer;
  114.  
  115.   {*********************************************************************}
  116.   {  Compares two strings up to a maximum of MaxLen characters.         }
  117.   {                                                                     }
  118.   {   Returns 0 if both strings are equal                               }
  119.   {   Returns < 0 if Str1 < Str2                                        }
  120.   {   Returns > 0 if Str1 > Str2                                        }
  121.   {*********************************************************************}
  122.  
  123. function StrLComp(Str1, Str2: PChar; MaxLen: Longint): Integer;
  124.  
  125.   {*********************************************************************}
  126.   {  Compares two strings up to a maximum of MaxLen characters.         }
  127.   {  The comparison is case insensitive.                                }
  128.   {   Returns 0 if both strings are equal                               }
  129.   {   Returns < 0 if Str1 < Str2                                        }
  130.   {   Returns > 0 if Str1 > Str2                                        }
  131.   {*********************************************************************}
  132.  
  133. function StrLIComp(Str1, Str2: PChar; MaxLen: Longint): Integer;
  134.  
  135.  {*********************************************************************}
  136.  {  Input: Str  -> String to search.                                   }
  137.  {         Ch   -> Character to find in Str.                           }
  138.  {  Return Value: Pointer to first occurence of Ch in Str, nil if      }
  139.  {                not found.                                           }
  140.  {  Remark: The null terminator is considered being part of the string }
  141.  {*********************************************************************}
  142.  
  143. function StrScan(Str: PChar; Ch: Char): PChar;
  144.  
  145.  {*********************************************************************}
  146.  {  Input: Str  -> String to search.                                   }
  147.  {         Ch   -> Character to find in Str.                           }
  148.  {  Return Value: Pointer to last occurence of Ch in Str, nil if       }
  149.  {                not found.                                           }
  150.  {  Remark: The null terminator is considered being part of the string }
  151.  {*********************************************************************}
  152.  
  153.  
  154. function StrRScan(Str: PChar; Ch: Char): PChar;
  155.  
  156.  {*********************************************************************}
  157.  {  Input: Str1 -> String to search.                                   }
  158.  {         Str2 -> String to match in Str1.                            }
  159.  {  Return Value: Pointer to first occurence of Str2 in Str1, nil if   }
  160.  {                not found.                                           }
  161.  {*********************************************************************}
  162.  
  163. function StrPos(Str1, Str2: PChar): PChar;
  164.  
  165.  {*********************************************************************}
  166.  {  Input: Str -> null terminated string to uppercase.                 }
  167.  {  Output:Str -> null terminated string in upper case characters.     }
  168.  {    Return Value: null terminated string in upper case characters.   }
  169.  {  Remarks: Case conversion is dependant on upcase routine.           }
  170.  {*********************************************************************}
  171.  
  172. function StrUpper(Str: PChar): PChar;
  173.  
  174.  {*********************************************************************}
  175.  {  Input: Str -> null terminated string to lower case.                }
  176.  {  Output:Str -> null terminated string in lower case characters.     }
  177.  {    Return Value: null terminated string in lower case characters.   }
  178.  {  Remarks: Only converts standard ASCII characters.                  }
  179.  {*********************************************************************}
  180.  
  181. function StrLower(Str: PChar): PChar;
  182.  
  183. { StrPas converts Str to a Pascal style string.                 }
  184.  
  185. function StrPas(Str: PChar): String;
  186.  
  187.  {*********************************************************************}
  188.  {  Input: Str  -> String to duplicate.                                }
  189.  {  Return Value: Pointer to the new allocated string. nil if no       }
  190.  {                  string allocated. If Str = nil then return value   }
  191.  {                  will also be nil (in this case, no allocation      }
  192.  {                  occurs). The size allocated is of StrLen(Str)+1    }
  193.  {                  bytes.                                             }
  194.  {*********************************************************************}
  195. function StrNew(P: PChar): PChar;
  196.  
  197. { StrDispose disposes a string that was previously allocated    }
  198. { with StrNew. If Str is NIL, StrDispose does nothing.          }
  199.  
  200. procedure StrDispose(P: PChar);
  201.  
  202. Implementation
  203.  
  204.  
  205.  function strlen(Str : pchar) : Longint;
  206.   var
  207.    counter : Longint;
  208.  Begin
  209.    counter := 0;
  210.    while Str[counter] <> #0 do
  211.      Inc(counter);
  212.    strlen := counter;
  213.  end;
  214.  
  215.  
  216.  
  217.  Function strpas(Str: pchar): string;
  218.  { only 255 first characters are actually copied. }
  219.   var
  220.    counter : byte;
  221.    lstr: string;
  222.  Begin
  223.    counter := 0;
  224.    lstr := '';
  225.    while (ord(Str[counter]) <> 0) and (counter < 255) do
  226.    begin
  227.      Inc(counter);
  228.      lstr[counter] := char(Str[counter-1]);
  229.    end;
  230.    lstr[0] := char(counter);
  231.    strpas := lstr;
  232.  end;
  233.  
  234.  Function StrEnd(Str: PChar): PChar;
  235.  var
  236.   counter: Longint;
  237.  begin
  238.    counter := 0;
  239.    while Str[counter] <> #0 do
  240.       Inc(counter);
  241.    StrEnd := @(Str[Counter]);
  242.  end;
  243.  
  244.  
  245.  Function StrCopy(Dest, Source:PChar): PChar;
  246.  var
  247.    counter : Longint;
  248.  Begin
  249.    counter := 0;
  250.    while Source[counter] <> #0 do
  251.    begin
  252.      Dest[counter] := char(Source[counter]);
  253.      Inc(counter);
  254.    end;
  255.    { terminate the string }
  256.    Dest[counter] := #0;
  257.    StrCopy := Dest;
  258.  end;
  259.  
  260.  
  261.  function StrCat(Dest,Source: PChar): PChar;
  262.  var
  263.   counter: Longint;
  264.   PEnd: PChar;
  265.  begin
  266.    PEnd := StrEnd(Dest);
  267.    counter := 0;
  268.    while (Source[counter] <> #0) do
  269.    begin
  270.      PEnd[counter] := char(Source[counter]);
  271.      Inc(counter);
  272.    end;
  273.    { terminate the string }
  274.    PEnd[counter] := #0;
  275.    StrCat := Dest;
  276.  end;
  277.  
  278.  function StrUpper(Str: PChar): PChar;
  279.  var
  280.   counter: Longint;
  281.  begin
  282.    counter := 0;
  283.    while (Str[counter] <> #0) do
  284.    begin
  285.      if Str[Counter] in [#97..#122,#128..#255] then
  286.         Str[counter] := Upcase(Str[counter]);
  287.      Inc(counter);
  288.    end;
  289.    StrUpper := Str;
  290.  end;
  291.  
  292.  function StrLower(Str: PChar): PChar;
  293.  var
  294.   counter: Longint;
  295.  begin
  296.    counter := 0;
  297.    while (Str[counter] <> #0) do
  298.    begin
  299.      if Str[counter] in [#65..#90] then
  300.         Str[Counter] := chr(ord(Str[Counter]) + 32);
  301.      Inc(counter);
  302.    end;
  303.    StrLower := Str;
  304.  end;
  305.  
  306.  
  307.   function StrPos(Str1,Str2: PChar): PChar;
  308.  var
  309.   count: Longint;
  310.   oldindex: Longint;
  311.   found: boolean;
  312.   Str1Length: Longint;
  313.   Str2Length: Longint;
  314.   ll: Longint;
  315.  Begin
  316.  
  317.    Str1Length := StrLen(Str1);
  318.    Str2Length := StrLen(Str2);
  319.    found := true;
  320.    oldindex := 0;
  321.  
  322.    { If the search string is greater than the string to be searched }
  323.    { it is certain that we will not find it.                        }
  324.    { Furthermore looking for a null will simply give out a pointer, }
  325.    { to the null character of str1 as in Borland Pascal.            }
  326.    if (Str2Length > Str1Length) or (Str2[0] = #0) then
  327.    begin
  328.      StrPos := nil;
  329.      exit;
  330.    end;
  331.  
  332.    Repeat
  333.      { Find first matching character of Str2 in Str1 }
  334.      { put index of this character in oldindex       }
  335.      for count:= oldindex to Str1Length-1 do
  336.      begin
  337.         if Str2[0] = Str1[count] then
  338.         begin
  339.            oldindex := count;
  340.            break;
  341.         end;
  342.         { nothing found - exit routine }
  343.         if count = Str1Length-1 then
  344.         begin
  345.            StrPos := nil;
  346.            exit;
  347.         end;
  348.      end;
  349.  
  350.      found := true;
  351.      { Compare the character strings }
  352.      { and check if they match.      }
  353.      for ll := 0 to Str2Length-1 do
  354.      begin
  355.        { no match, stop iteration }
  356.         if (Str2[ll] <> Str1[ll+oldindex]) then
  357.         begin
  358.            found := false;
  359.            break;
  360.         end;
  361.      end;
  362.      { Not found, the index will no point at next character }
  363.      if not found then
  364.        Inc(oldindex);
  365.      { There was a match }
  366.      if found then
  367.      begin
  368.         StrPos := @(Str1[oldindex]);
  369.         exit;
  370.      end;
  371.    { If we have gone through the whole string to search }
  372.    { then exit routine.                                 }
  373.    Until (Str1Length-oldindex) <= 0;
  374.    StrPos := nil;
  375.  end;
  376.  
  377.  
  378.  function StrScan(Str: PChar; Ch: Char): PChar;
  379.    Var
  380.      count: Longint;
  381.   Begin
  382.  
  383.    count := 0;
  384.    { As in Borland Pascal , if looking for NULL return null }
  385.    if ch = #0 then
  386.    begin
  387.      StrScan := @(Str[StrLen(Str)]);
  388.      exit;
  389.    end;
  390.    { Find first matching character of Ch in Str }
  391.    while Str[count] <> #0 do
  392.    begin
  393.      if Ch = Str[count] then
  394.       begin
  395.           StrScan := @(Str[count]);
  396.           exit;
  397.       end;
  398.      Inc(count);
  399.    end;
  400.    { nothing found. }
  401.    StrScan := nil;
  402.  end;
  403.  
  404.  
  405.  
  406.  function StrRScan(Str: PChar; Ch: Char): PChar;
  407.  Var
  408.   count: Longint;
  409.   index: Longint;
  410.  Begin
  411.    count := Strlen(Str);
  412.    { As in Borland Pascal , if looking for NULL return null }
  413.    if ch = #0 then
  414.    begin
  415.      StrRScan := @(Str[count]);
  416.      exit;
  417.    end;
  418.    Dec(count);
  419.    for index := count downto 0 do
  420.    begin
  421.      if Ch = Str[index] then
  422.       begin
  423.           StrRScan := @(Str[index]);
  424.           exit;
  425.       end;
  426.    end;
  427.    { nothing found. }
  428.    StrRScan := nil;
  429.  end;
  430.  
  431.  
  432.  function StrNew(p:PChar): PChar;
  433.       var
  434.          len : Longint;
  435.          tmp : pchar;
  436.       begin
  437.          strnew:=nil;
  438.          if (p=nil) or (p^=#0) then
  439.            exit;
  440.          len:=strlen(p)+1;
  441.          getmem(tmp,len);
  442.          if tmp<>nil then
  443.            strmove(tmp,p,len);
  444.          StrNew := tmp;
  445.       end;
  446.  
  447.  
  448.   Function StrECopy(Dest, Source: PChar): PChar;
  449.  { Equivalent to the following:                                          }
  450.  {  strcopy(Dest,Source);                                                }
  451.  {  StrECopy := StrEnd(Dest);                                            }
  452.  var
  453.    counter : Longint;
  454.  Begin
  455.    counter := 0;
  456.    while Source[counter] <> #0 do
  457.    begin
  458.      Dest[counter] := char(Source[counter]);
  459.      Inc(counter);
  460.    end;
  461.    { terminate the string }
  462.    Dest[counter] := #0;
  463.    StrECopy:=@(Dest[counter]);
  464.  end;
  465.  
  466.  
  467.    Function StrPCopy(Dest: PChar; Source: String):PChar;
  468.    var
  469.     counter : byte;
  470.   Begin
  471.     counter := 0;
  472.    { if empty pascal string  }
  473.    { then setup and exit now }
  474.    if Source = '' then
  475.    Begin
  476.      Dest[0] := #0;
  477.      StrPCopy := Dest;
  478.      exit;
  479.    end;
  480.    for counter:=1 to length(Source) do
  481.    begin
  482.      Dest[counter-1] := Source[counter];
  483.    end;
  484.    { terminate the string }
  485.    Dest[counter] := #0;
  486.    StrPCopy:=Dest;
  487.  end;
  488.  
  489.  
  490.  procedure strdispose(p : pchar);
  491.  begin
  492.    if p<>nil then
  493.       freemem(p,strlen(p)+1);
  494.  end;
  495.  
  496.  
  497.  function strmove(dest,source : pchar;l : Longint) : pchar;
  498.  begin
  499.    move(source^,dest^,l);
  500.    strmove:=dest;
  501.  end;
  502.  
  503.  
  504.  function strlcat(dest,source : pchar;l : Longint) : pchar;
  505.  var
  506.    destend : pchar;
  507.  begin
  508.    destend:=strend(dest);
  509.    l:=l-(destend-dest);
  510.    strlcat:=strlcopy(destend,source,l);
  511.  end;
  512.  
  513.  
  514.  Function StrLCopy(Dest,Source: PChar; MaxLen: Longint): PChar;
  515.   var
  516.    counter: Longint;
  517.  Begin
  518.    counter := 0;
  519.    { To be compatible with BP, on a null string, put two nulls }
  520.    If Source[0] = #0 then
  521.    Begin
  522.      Dest[0]:=Source[0];
  523.      Inc(counter);
  524.    end;
  525.    while (Source[counter] <> #0)  and (counter < MaxLen) do
  526.    Begin
  527.       Dest[counter] := char(Source[counter]);
  528.       Inc(counter);
  529.    end;
  530.    { terminate the string }
  531.    Dest[counter] := #0;
  532.    StrLCopy := Dest;
  533.  end;
  534.  
  535.  
  536.  function StrComp(Str1, Str2 : PChar): Integer;
  537.      var
  538.       counter: Longint;
  539.      Begin
  540.         counter := 0;
  541.        While str1[counter] = str2[counter] do
  542.        Begin
  543.          if (str2[counter] = #0) or (str1[counter] = #0) then
  544.             break;
  545.          Inc(counter);
  546.        end;
  547.        StrComp := ord(str1[counter]) - ord(str2[counter]);
  548.      end;
  549.  
  550.      function StrIComp(Str1, Str2 : PChar): Integer;
  551.      var
  552.       counter: Longint;
  553.       c1, c2: char;
  554.      Begin
  555.         counter := 0;
  556.         c1 := upcase(str1[counter]);
  557.         c2 := upcase(str2[counter]);
  558.        While c1 = c2 do
  559.        Begin
  560.          if (c1 = #0) or (c2 = #0) then break;
  561.          Inc(counter);
  562.          c1 := upcase(str1[counter]);
  563.          c2 := upcase(str2[counter]);
  564.       end;
  565.        StrIComp := ord(c1) - ord(c2);
  566.      end;
  567.  
  568.  
  569.      function StrLComp(Str1, Str2 : PChar; MaxLen: Longint): Integer;
  570.      var
  571.       counter: Longint;
  572.       c1, c2: char;
  573.      Begin
  574.         counter := 0;
  575.        if MaxLen = 0 then
  576.        begin
  577.          StrLComp := 0;
  578.          exit;
  579.        end;
  580.        Repeat
  581.          if (c1 = #0) or (c2 = #0) then break;
  582.          c1 := str1[counter];
  583.          c2 := str2[counter];
  584.          Inc(counter);
  585.       Until (c1 <> c2) or (counter >= MaxLen);
  586.        StrLComp := ord(c1) - ord(c2);
  587.      end;
  588.  
  589.  
  590.  
  591.      function StrLIComp(Str1, Str2 : PChar; MaxLen: Longint): Integer;
  592.      var
  593.       counter: Longint;
  594.       c1, c2: char;
  595.      Begin
  596.         counter := 0;
  597.        if MaxLen = 0 then
  598.        begin
  599.          StrLIComp := 0;
  600.          exit;
  601.        end;
  602.        Repeat
  603.          if (c1 = #0) or (c2 = #0) then break;
  604.          c1 := upcase(str1[counter]);
  605.          c2 := upcase(str2[counter]);
  606.          Inc(counter);
  607.       Until (c1 <> c2) or (counter >= MaxLen);
  608.        StrLIComp := ord(c1) - ord(c2);
  609.      end;
  610. end.
  611. {
  612.   $Log: strings.pp,v $
  613.   Revision 1.2  1998/07/01 14:29:42  carl
  614.     * strpas bugfix
  615.  
  616.   Revision 1.1.1.1  1998/03/25 11:18:46  root
  617.   * Restored version
  618.  
  619.   Revision 1.4  1998/01/26 12:02:01  michael
  620.   + Added log at the end
  621.  
  622.  
  623.   
  624.   Working file: rtl/template/strings.pp
  625.   description:
  626.   ----------------------------
  627.   revision 1.3
  628.   date: 1998/01/05 00:41:57;  author: carl;  state: Exp;  lines: +4 -4
  629.   * Esthetic (spelling mistake) fix
  630.   ----------------------------
  631.   revision 1.2
  632.   date: 1997/12/01 12:45:49;  author: michael;  state: Exp;  lines: +14 -1
  633.   + added copyright reference in header.
  634.   ----------------------------
  635.   revision 1.1
  636.   date: 1997/11/27 08:33:49;  author: michael;  state: Exp;
  637.   Initial revision
  638.   ----------------------------
  639.   revision 1.1.1.1
  640.   date: 1997/11/27 08:33:49;  author: michael;  state: Exp;  lines: +0 -0
  641.   FPC RTL CVS start
  642.   =============================================================================
  643. }
  644.